perm filename DRWCIR.SAI[PIC,HE] blob sn#430333 filedate 1979-04-03 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ENTRY DRWCIRC,CIRC,CIRINIT,CIREND,CONCIR
C00005 ENDMK
C⊗;
ENTRY DRWCIRC,CIRC,CIRINIT,CIREND,CONCIR;
BEGIN "DRWCIR"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "GRAPH.DCL" SOURCE!FILE;
EXTERNAL INTEGER TEKWHERE;
OWN INTEGER CIRT;
SIMPLE INTERNAL PROCEDURE DRWCIRC(REAL I,J,R);
    BEGIN
    REAL X,Y,R2,X1,Y1;
    R2←R*R;
    MOVEA(X1←I-R,Y1←J);
    FOR X←-R STEP 0.10 UNTIL R, R STEP -0.10 UNTIL -R DO
	DRAWA(X1←I+X,Y1←J+SQRT(R2-X*X));
    END;

PRELOAD!WITH 3.0,-8.0,8.0,-8.0,8.0,0.0,0.0,-7.0,7.0,-4.0,-4.0,3.5,-1.0;
SAFE INTERNAL REAL ARRAY XLC[1:13];
PRELOAD!WITH 2.0,8.0,8.0,-8.0,-8.0,7.0,-7.0,0.0,0.0,5.0,-4.0,-3.5,2.0;
SAFE INTERNAL REAL ARRAY YLC[1:13];
SIMPLE INTERNAL PROCEDURE CIRC(INTEGER N; STRING LABB);
    BEGIN
    DRWCIRC(XLC[N],YLC[N],1.0);
    STRAT(LABB,XLC[N]-1,YLC[N]);
    END;

SIMPLE INTERNAL PROCEDURE CIRINIT;
    BEGIN
    IF CIRT=0 THEN BEGIN
	PCTR(TEKWHERE);
	INITT(450);
	VWINDO(-10.0,20.0,-10.0,20.0);
	END;
    CIRT←-1;
    END;
SIMPLE INTERNAL PROCEDURE CIREND;
    BEGIN
    ENDPCT;
    CIRT←0;
    END;
SIMPLE INTERNAL PROCEDURE CONCIR(INTEGER C1,C2; STRING LABB; REAL POSIT);
    BEGIN
    REAL DX,DY,DZ,SX,SY,EX,EY;
    REAL LX,LY;
    DX←XLC[C1]-XLC[C2];
    DY←YLC[C1]-YLC[C2];
    DZ←SQRT(DX*DX+DY*DY);
    DX←DX/DZ;
    DY←DY/DZ;
    SX←XLC[C1]-DX;
    SY←YLC[C1]-DY;
    EX←XLC[C2]+DX;
    EY←YLC[C2]+DY;
    MOVEA(SX,SY);
    DRAWA(EX,EY);
    LX←SX+(EX-SX)*POSIT-0.5;
    LY←SY+(EY-SY)*POSIT;
    STRAT(LABB,LX,LY);
    DX←DX/2.0;  DY←DY/2.0;
    SX←EX+DX+DY;	SY←EY+DY-DX;
    MOVEA(SX,SY);	DRAWA(EX,EY);
    SX←EX+DX-DY;	SY←EY+DY+DX;
    MOVEA(SX,SY);	DRAWA(EX,EY);
    END;
END "DRWCIR";